home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE20 / LISTBOX / LBOXTAB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-20  |  1.5 KB  |  66 lines

  1. unit LBoxTab;
  2.  
  3. interface
  4.  
  5. uses
  6.   StdCtrls, Controls, Classes;
  7.  
  8. type
  9.   TTabListbox = class(TListbox)
  10.   private
  11.     FTabStopSupport: Boolean;
  12.     FScrollWidth: Word;
  13.   protected
  14.     procedure CreateParams(var Params: TCreateParams); override;
  15.     procedure SetTabStopSupport(Value: Boolean);
  16.   public
  17.     function SetTabStops(Tabs: array of Integer): Boolean;
  18.   published
  19.     property TabStopSupport: Boolean
  20.       read FTabStopSupport write SetTabStopSupport
  21.       default False;
  22.     { Note this property has been given a default of False
  23.       but that value is not being assigned to FTabStopSupport
  24.       since it will get that value anyway. All class data
  25.       fields are initialised with zero memory byte values }
  26.   end;
  27.  
  28. procedure Register;
  29.  
  30. implementation
  31.  
  32. uses
  33.   WinTypes, Messages;
  34.  
  35. procedure TTabListbox.CreateParams(var Params: TCreateParams);
  36. const
  37.   TabStopSupport: array[Boolean] of Longint = (0, lbs_UseTabStops);
  38. begin
  39.   inherited CreateParams(Params);
  40.   Params.Style := Params.Style or TabStopSupport[FTabStopSupport];
  41. end;
  42.  
  43. procedure TTabListbox.SetTabStopSupport(Value: Boolean);
  44. begin
  45.   if Value <> FTabStopSupport then
  46.   begin
  47.     FTabStopSupport := Value;
  48.     RecreateWnd;
  49.   end;
  50. end;
  51.  
  52. function TTabListbox.SetTabStops(Tabs: array of Integer): Boolean;
  53. begin
  54.   Result := Perform(lb_SetTabStops, High(Tabs) - Low(Tabs) + 1,
  55.     Longint(@Tabs)) <> 0;
  56.   if Result then
  57.     Repaint;
  58. end;
  59.  
  60. procedure Register;
  61. begin
  62.   RegisterComponents('Clinic', [TTabListBox]);
  63. end;
  64.  
  65. end.
  66.